perm filename HOMEW1.F79[206,LSP] blob
sn#485154 filedate 1979-10-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 .REQUIRE "206MAC.PUB[206,LSP]" source_file
C00003 00003 .hd206 FALL 1979
C00008 00004 .once center
C00016 00005 .begin center
C00021 00006 .begin center
C00031 00007 .begin center
C00038 ENDMK
C⊗;
.REQUIRE "206MAC.PUB[206,LSP]" source_file;
.
.odd heading(,,{page}) ;
.even heading({page}, , ) ;
.
.LSPFONT
.basicops
.
.allops
.itemmac 1;
.
.PORTION MAINPORTION
.hd206 FALL 1979
.PAGE ← 1
.hw 1, |Oct. 12|
.begin
.indent 0,3
.item ← 0
#. Write a program to compute ⊗commontail[u,v], the longest common
sublist of ⊗u and ⊗v ending with the ends of the lists. Thus
⊗⊗⊗commontail[$$(A B C D E),(A C D E)$] = $$(C D E)$⊗.
#. Write a program to compute ⊗mapleaf[f,x], the list of expressions
⊗f_a such that ⊗a is an atom occuring in ⊗x, appearing in the same order
as the atoms appear in the printed expression. Thus
⊗⊗⊗mapleaf[λz.<z>, $$((A . B) . C)$] = $$((A) (B) (C))$⊗
[Note that ⊗⊗mapleaf[λz.z,x]=fringe x⊗]
#. Consider arithmetic expressions as represented in Chapters I and II.
Namely an expression is
.begin nofill indent 8,8 group
(i) a number (satisfies ⊗numberp),
(ii) a variable (not a number and satisfies qqat),
(iii) a sum : $PLUS . < list of expressions > or
(iv) a product : $TIMES . < list of expressions >.
.end
(For simplicity, assume the sum and product lists always have at least 2 elements.)
The function ⊗sop converts such expressions into sum of products
form, eg. the resulting expression is either a monomial
or a sum of monomial terms which has the form $$PLUS$_._<list_of_monomials>.
A monomial is either a number, a variable, or a product of the
form $$TIMES$_._< list of numbers or variables >.
.begin nofill indent 8,8 group
⊗⊗sop $$(TIMES (PLUS X 1) (PLUS Y Z) 3)$=⊗
______$$(PLUS (TIMES X Y 3) (TIMES X Z 3) (TIMES 1 Y 3) (TIMES 1 Z 3))$
.end
Write a program to comute ⊗sop.
Try it on expressions returned by ⊗diff.
What about ⊗⊗diff[sop_e,v]⊗ and ⊗⊗sop_diff[sop_e,v]⊗?
Consider how you might convince a user of your program that
⊗⊗numval[e,alist]=numval[sop_e,alist]⊗. (⊗numval is defined on page 38.)
#. Consider an alternate representation of graphs by lists in which
a graph is a list of edges and an edge is a list of the form
⊗⊗⊗$$(<source vertex> <target vertex> . <data>)$.⊗
and represents an edge of the graph from the $<source_vertex> to
the $<target_vertex>.
In the case of the simple unlabeled graphs described in Chapter I, the
$<data> is just qNIL.
##. Write programs ⊗mk-edge-rep[g] and ⊗mk-neigh-rep[g] that convert
a representation of a graph as a list of neighbors (a la Chpater I.) to a
representation as a list of edges, and vice versa. Thus
.begin nofill indent 8,8 group
⊗⊗mk-edge-rep[$$((A B)(B A C D)(C D B)(D B C))$]=⊗
___________$$((A B)(B A)(B C)(B D)(C D)(C B)(D B)(D C))$
⊗⊗mk-neigh-rep[$$((A B)(B A)(B C)(B D)(C D)(C B)(D B)(D C))$]=⊗
___________$$((A B)(B A C D)(C D B)(D B C))$
.end
A current graph is a directed graph with edges labeled by numbers
corresponding to the "current" flowing into the target vertex along that
edge. A current graph satisfies Kirchoff's law if for each vertex,
the sum of the currents flowing in is equal to the sum of the currents
flowing out.
##. Write a program ⊗Kirch[g] that returns qT if ⊗g is a
current graph satisfying Kirchoff's law, and qNIL otherwise. Thus
⊗⊗⊗Kirch[$$((A B 1) (A D 1) (B C 1) (C A 2) (D C 1))$] =qT⊗
⊗⊗⊗Kirch[$$((A D 1) (B D 1) (D C 2))$] =qNIL⊗
.next page
.once center
Solutions for Homework 1
.items←0
.begin center
PROBLEM 1
.end
Students handed in variations on three different solutions
to this problem. The first solution was the most common.
We will give everything in both internal and external notation.
First Solution:
.NOFILL
⊗⊗ commontail[u, v] ← reverse commonhead[reverse u, reverse v]⊗
⊗⊗ commonhead[u, v] ← ⊗
⊗⊗ qif qn u ∨ qn v ∨ ¬[qa u = qa v] qthen qNIL qelse qa u . commonhead[qd u, qd v]⊗
.FILL
.begin select 6 indent 8,8 verbatim
(DEFUN COMMONTAIL (U V)
(REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
(DEFUN COMMONHEAD (U V)
(COND ((OR (NULL U)
(NULL V)
(NOT (EQUAL (CAR U) (CAR V))))
NIL)
(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
.end
This solution makes use of the fact that it is much more convenient, and
generally more efficient, to work on the front of a list, rather than the end.
A simple variation of this solution is to make COMMONHEAD iterative, accumulating
the answer in its third argument. Note that this eliminates the need for the final
REVERSE of the previous program.
.nofill
⊗⊗ commontail[u, v] ← commonhead[reverse u, reverse v, qNIL]⊗
⊗⊗ commonhead[u, v, w] ← ⊗
⊗⊗ qif qn u ∨ qn v ∨ ¬[qa u = qa v] qthen w⊗
⊗⊗ qelse commonhead[qd u, qd v, qa u . w]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN COMMONTAIL (U V)
(COMMONHEAD (REVERSE U) (REVERSE V) NIL))
(DEFUN COMMONHEAD (U V W)
(COND ((OR (NULL U)
(NULL V)
(NOT (EQUAL (CAR U) (CAR V))))
W)
(T (COMMONHEAD (CDR U) (CDR V) (CONS (CAR U) W)))))
.end
.next page
Second Solution:
.nofill
⊗⊗ commontail[u, v] ← ⊗
⊗⊗ qif length u = length v qthen tail[u, v]⊗
⊗⊗ qelse qif length u < length v qthen commontail[u, qd v]⊗
⊗⊗ qelse commontail[qd u, v]⊗
⊗⊗ tail[u, v] ← qif u = v qthen u qelse tail[qd u, qd v]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN COMMONTAIL (U V)
(COND ((EQ (LENGTH U) (LENGTH V)) (TAIL U V))
((LESSP (LENGTH U) (LENGTH V)) (COMMONTAIL U (CDR V)))
(T (COMMONTAIL (CDR U) V))))
(DEFUN TAIL (U V)
(COND ((EQUAL U V) U)
(T (TAIL (CDR U) (CDR V)))))
.end
In this solution, COMMONTAIL CDR's through the longer of its two inputs
until the two have equal length. TAIL then CDR's similtaneously through
both until they are equal. This equal portion is the answer.
Note that the proof of termination of each of these programs is somewhat
subtle. In the case of COMMONTAIL, one must prove that for some recursive call,
the arguments will have equal length. For TAIL, one must show that for some recursive call
the two arguments will be equal. This depends crucially on the fact that
the two arguments always have equal length.
A simple variation of this solution uses a LAMBDA expression to avoid
recalculation of U's and V's lengths.
.nofill
⊗⊗ commontail[u, v] ← ⊗
⊗⊗ {length u, length v}[λu-length, v-length: ⊗
⊗⊗ qif u-length = v-length qthen tail[u, v]⊗
⊗⊗ qelse qif u-length < v-length qthen commontail[u, qd v]⊗
⊗⊗ qelse commontail[qd u, v]]⊗
;TAIL as before
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN COMMONTAIL (U V)
((LAMBDA (U-LENGTH V-LENGTH)
(COND ((EQ U-LENGTH V-LENGTH) (TAIL U V))
((LESSP U-LENGTH V-LENGTH) (COMMONTAIL U (CDR V)))
(T (COMMONTAIL (CDR U) V))))
(LENGTH U)
(LENGTH V)))
.end
.NEXT PAGE
Solution Three:
.nofill
⊗⊗ commontail[u, v] ← ⊗
⊗⊗ qif qn u qthen qNIL⊗
⊗⊗ qelse qif u-is-tail-of-v?[u, v] qthen u⊗
⊗⊗ qelse commontail[qd u, v]⊗
⊗⊗ u-is-tail-of-v?[u, v] ← ⊗
⊗⊗ qif u = v qthen qT⊗
⊗⊗ qelse qif qn v qthen qNIL⊗
⊗⊗ qelse u-is-tail-of-v[u, qd v]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN COMMONTAIL (U V)
(COND ((NULL U) NIL)
((U-IS-TAIL-OF-V? U V) U)
(T (COMMONTAIL (CDR U) V))))
(DEFUN U-IS-TAIL-OF-V? (U V)
(COND ((EQUAL U V) T)
((NULL V) NIL)
(T (U-IS-TAIL-OF-V U (CDR V)))))
.end
In this solution, COMMONTAIL asks if U is a tail of V, and if so returns U.
If not, then it recursively asks is (CDR U) is a tail of V, and so on.
U-IS-TAIL-OF-V? works by CDR'ing down V, checking whether it is equal to U.
.next page
.begin center
PROBLEM 2
.end
Again, there were several solutions handed in.
Solution One
.nofill
⊗⊗ mapleaf[f, x] ← ⊗
⊗⊗ qif qat x qthen <funcall[f, x]>⊗
⊗⊗ qelse mapleaf[f, qa x] * mapleaf[f, qd x]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN MAPLEAF (F X)
(COND ((ATOM X) (LIST (FUNCALL F X)))
(T (APPEND (MAPLEAF F (CAR X))
(MAPLEAF F (CDR X))))))
.end
A basic problem encountered in all solutions is how to get the function which is F's value
to be applied to the atoms of the second argument. Simply using (F X) does
not work in the Lisp you usually get. It results in F UNDEFINED FUNCTION.
You can change Lisp so that when it encounters a symbol which it wants
to be a function, but isn't, it evaluates that symbol in hopes that its
value will be a function. You can do this by saying (SSTATUS PUNT NIL) to Lisp.
Magic, huh! If you don't want to do this, you can achieve the desired effect in
several ways.
A nice way is with FUNCALL, a Lisp
primitive, as above. Another way is to use (APPLY F (LIST X)). The only difference
between FUNCALL and APPLY is that you must put the arguments in a list when using APPLY.
A third way is to use EVAL. Notice that (EVAL (LIST F X)) does not work
because Lisp first evaluates (LIST F X), resulting in a list which
looks like (<the value of F> <the value of X>). Now EVAL is applied to this.
This causes Lisp to try to evaluate <the value of X>, which is usually some
random atom, and causes an error: <value of X> UNBOUND VARIABLE.
There are two ways around this. One is to use (EVAL (LIST F 'X)). Then
(LIST F 'X) evaluates to (<value of F> X), which evaluats properly. Alternatively,
you can use (EVAL (LIST F (LIST 'QUOTE X))). (LIST F (LIST 'QUOTE X)) evaluates
to (<value of F> (QUOTE <value of X>)), which then evaluates properly.
.next page
Solution Two
.nofill
⊗⊗ mapleaf[f, x] ← mapleaf1[f, x, qNIL]⊗
⊗⊗ mapleaf1[f, x, z] ← ⊗
⊗⊗ qif qat x qthen funcall[f, x] . z⊗
⊗⊗ qelse mapleaf1[f, qa x, mapleaf1[f, qd x, z]]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN MAPLEAF (F X) (MAPLEAF1 F X NIL))
(DEFUN MAPLEAF1 (F X Z)
(COND ((ATOM X) (CONS (FUNCALL F X) Z))
(T (MAPLEAF1 F
(CAR X)
(MAPLEAF1 F
(CDR X)
Z)))))
.end
This definition is actually a variation of the efficient version of FLATTEN
given in the notes.
.skip 10
Solution Three
Speaking of FLATTEN:
.nofill
⊗⊗ mapleaf[f, x] ← mapcar[f, flatten x]⊗
.FILL
.begin select 6 indent 8,8 verbatim
(DEFUN MAPLEAF (F X)
(MAPCAR F (FLATTEN X)))
.end
.next page
.begin center
PROBLEM 3
.end
This problem was clearly the hardest in the bunch. All solutions
were variations, complications, or perversions of the same idea.
.nofill
⊗⊗ sop x ← qif good-expression? x qthen add-plus-and-times sop1 x⊗
⊗⊗ qelse $$BAD-INPUT$⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN SOP (X)
(COND ((GOOD-EXPRESSION? X)
(ADD-PLUS-AND-TIMES (SOP1 X)))
(T 'BAD-INPUT)))
.END
First we check that the input has the required form. If so,
SOP1 will do the real work, but for convenience, it will return
a sop form which does not have the PLUS's or TIMES's in it.
This form looks like ((...)(...) ...), where the things in the
inner lists are atoms. This list really means (PLUS (TIMES ...) (TIMES ...) ...) .
ADD-PLUS-AND-TIMES will fix it up. The problem is that we always have the PLUS's
and TIME's in the sop form, then they get in the way; we have to keep taking them off
to get at the stuff we really want!
.nofill
⊗⊗ sop1 x ← ⊗
⊗⊗ qif qat x qthen <<x>>⊗
⊗⊗ qelse qif qa x = $$PLUS$ qthen map-append[$$SOP1$, qd x]⊗
⊗⊗ qelse distribute-times-over-list-of-pluses mapcar[$$SOP1$, qd x]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN SOP1 (X)
(COND ((ATOM X) (LIST (LIST X)))
((EQ (CAR X) 'PLUS) (MAP-APPEND 'SOP1 (CDR X)))
(T (DISTRIBUTE-TIMES-OVER-LIST-OF-PLUSES (MAPCAR 'SOP1 (CDR X))))))
.end
There are three case, as indicated by the conditional.
Note what SOP1 does to atoms. This is so that the output of SOP1 always
has the same form. MAP-APPEND is like MAPCAR except that the results
are all APPEND'd together instead of being CONS'd into a list. It is defined below.
DISTRIBUTE-TIMES-OVER-LIST-OF-PLUSES takes a list of sop forms, where the list means
that the sop forms are to be multiplied, and distributes this multiplication
over the implied (remember we left out the PLUS) PLUSes that each sop form
represents. The result is in sop form.
Notice that the argument to DISTRIBUTE-TIMES-OVER-LIST-OF-PLUSES (in SOP1) is never empty,
in fact it is never shorter than two.
.nofill
⊗⊗ distribute-times-over-list-of-pluses l ← ⊗
⊗⊗ qif qn qdl qthen l⊗
⊗⊗ qelse distribute-times-over-plus[⊗
⊗⊗ qa l, distribute-times-over-list-of-pluses qd l]⊗
⊗⊗ distribute-times-over-plus[plus1, plus2] ← ⊗
⊗⊗ map-append[⊗
⊗⊗ [λtimes1: mapcar[[λtimes2: times1 * times2], plus1]], ⊗
⊗⊗ plus2]⊗
.fill
.next page
.begin select 6 indent 8,8 verbatim
(DEFUN DISTRIBUTE-TIMES-OVER-LIST-OF-PLUSES (L)
(COND ((NULL (CDR L)) L)
(T (DISTRIBUTE-TIMES-OVER-PLUS
(CAR L)
(DISTRIBUTE-TIMES-OVER-LIST-OF-PLUSES (CDR L))))))
(DEFUN DISTRIBUTE-TIMES-OVER-PLUS (PLUS1 PLUS2)
(MAP-APPEND
(FUNCTION (LAMBDA (TIMES1)
(MAPCAR
(FUNCTION (LAMBDA (TIMES2)
(APPEND TIMES1 TIMES2)))
PLUS1)))
PLUS2))
.end
The lambda-variables are named TIMES1 and TIMES2 to suggest that their
values are products, as is actually the case. These products are represented
simply by lists of atoms. In order to take the product of two such lists,
we simply append them. Note that it does not matter whether the roles
of TIMES1 and TIMES2 are interchanged; and similarly for PLUS1 and PLUS2.
.nofill
⊗⊗ map-append[f, l] ← ⊗
⊗⊗ qif qn l qthen qNIL qelse funcall[f, qa l] * map-append[f, qd l]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN MAP-APPEND (F L)
(COND ((NULL L) NIL)
(T (APPEND (FUNCALL F (CAR L))
(MAP-APPEND F (CDR L))))))
.end
Lets not forget GOOD-EXPRESSION?. We will be a little fussy and not
let NIL be variable.
.nofill
⊗⊗ good-expression? e ← ⊗
⊗⊗ qif qat e ∧ ¬qn e qthen qT⊗
⊗⊗ qelse qif [qa e = $$PLUS$ ∨ qa e = $$TIMES$] ∧ ¬[length e < 3] qthen ⊗
⊗⊗ list-of-good-expressions? qd e⊗
⊗⊗ qelse qNIL⊗
⊗⊗ list-of-good-expressions? l ← ⊗
⊗⊗ qif qn l qthen qT⊗
⊗⊗ qelse qif good-expression? qa l qthen list-of-good-expressions? qd l⊗
⊗⊗ qelse qNIL⊗
.fill
.next page
.begin select 6 indent 8,8 verbatim
(DEFUN GOOD-EXPRESSION? (E)
(COND ((AND (ATOM E)
(NOT (NULL E)))
T)
((AND (OR (EQ (CAR E) 'PLUS)
(EQ (CAR E) 'TIMES))
(NOT (LESSP (LENGTH E) 3)))
(LIST-OF-GOOD-EXPRESSIONS? (CDR E)))
(T NIL)))
(DEFUN LIST-OF-GOOD-EXPRESSIONS? (L)
(COND ((NULL L) T)
((GOOD-EXPRESSION? (CAR L))
(LIST-OF-GOOD-EXPRESSIONS? (CDR L)))
(T NIL))))
.end
Many people had a definition of SOP which looked for bad inputs as it went along, instead
of using a seperate program to completely check out the input before doing any SOP
stuff.
The trouble with that is that if the bad expression is noticed in some recursive call
of SOP, i.e., not in the top level call,
then it will return the error message to whoever called it. Unless that calling program
is specially prepared for such messages, it will munch happily along, thinking
SOP gave it an sop form. Pretty soon some wretched error will occur as it finds
out otherwise. This is probably not what is supposed to happen to error messages!
Last but not least:
.nofill
⊗⊗ add-plus-and-times s ← ⊗
⊗⊗ qif qn qd s qthen [qif qn qda s qthen qaa s qelse $$TIMES$ . qa s]⊗
⊗⊗ qelse $$PLUS$⊗
⊗⊗ . mapcar[⊗
⊗⊗ [λtimes: ⊗
⊗⊗ qif qn qd times qthen qa times qelse $$TIMES$ . times], ⊗
⊗⊗ s]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN ADD-PLUS-AND-TIMES (S)
(COND ((NULL (CDR S)) ;trivial cases
(COND ((NULL (CDAR S)) (CAAR S)) ;just the atom
(T (CONS 'TIMES (CAR S))))) ;no PLUS necessary
(T (CONS 'PLUS
(MAPCAR
(FUNCTION (LAMBDA (TIMES)
(COND ((NULL (CDR TIMES)) (CAR TIMES))
;no TIMES necessary
(T (CONS 'TIMES TIMES)))))
S)))))
.end
.next page
.begin center
PROBLEM 4
.end
The following program takes a graph in neighbor-representation and returns
its edge representation.
.nofill
⊗⊗ make-edge-rep g ← ⊗
⊗⊗ qif qn g qthen qNIL⊗
⊗⊗ qelse mapcar[[λx: <qaa g, x>], qda g] * make-edge-rep qd g⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN MAKE-EDGE-REP (G)
(COND ((NULL G) NIL)
(T (APPEND
(MAPCAR
(FUNCTION (LAMBDA (X)
(LIST (CAAR G) X)))
(CDAR G))
(MAKE-EDGE-REP (CDR G))))))
.end
Its "inverse" is:
.nofill
⊗⊗ make-neigh-rep g ← ⊗
⊗⊗ map-append[[λx: make-neighbor-list[x, g]], all-nodes g]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN MAKE-NEIGH-REP (G)
(MAP-APPEND
(FUNCTION (LAMBDA (X)
(MAKE-NEIGHBOR-LIST X G)))
(ALL-NODES G)))
.end
ALL-NODES produces a list of all of the nodes of G.
We MAP-APPEND through this list, creating the neighbor-list for each.
.nofill
⊗⊗ all-nodes g ← ⊗
⊗⊗ qif qn g qthen qNIL⊗
⊗⊗ qelse {all-nodes qd g}[λh: ⊗
⊗⊗ qif qaa g ε h ∧ qada g ε h qthen h⊗
⊗⊗ qelse qif qaa g ε h qthen qada g . h⊗
⊗⊗ qelse qif qada g ε h qthen qaa g . h⊗
⊗⊗ qelse qaa g . [qada g . h]]⊗
.fill
.next page
.begin select 6 indent 8,8 verbatim
(DEFUN ALL-NODES (G)
(COND ((NULL G) NIL)
(T ((LAMBDA (H)
(COND ((AND (MEMBER (CAAR G) H)
(MEMBER (CADAR G) H))
H)
((MEMBER (CAAR G) H)
(CONS (CADAR G) H))
((MEMBER (CADAR G) H)
(CONS (CAAR G) H))
(T (CONS (CAAR G) (CONS (CADAR G) H)))))
(ALL-NODES (CDR G))))))
.end
Of course, this can also be done with an accumulator NODES, initialized to NIL:
.nofill
⊗⊗ all-nodes[g, nodes] ← ⊗
⊗⊗ qif qn g qthen nodes⊗
⊗⊗ qelse qif qaa g ε nodes ∧ qada g ε nodes qthen all-nodes[qd g, nodes]⊗
⊗⊗ qelse qif qaa g ε nodes qthen all-nodes[qd g, qada g . nodes]⊗
⊗⊗ qelse qif qada g ε nodes qthen all-nodes[qd g, qaa g . nodes]⊗
⊗⊗ qelse all-nodes[qd g, qaa g . [qada g . nodes]]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN ALL-NODES (G NODES)
(COND ((NULL G) NODES)
((AND (MEMBER (CAAR G) NODES)
(MEMBER (CADAR G) NODES))
(ALL-NODES (CDR G) NODES))
((MEMBER (CAAR G) NODES)
(ALL-NODES (CDR G) (CONS (CADAR G) NODES)))
((MEMBER (CADAR G) NODES)
(ALL-NODES (CDR G) (CONS (CAAR G) NODES)))
(T (ALL-NODES (CDR G) (CONS (CAAR G)
(CONS (CADAR G) NODES))))))
.end
Here's a convenient way to do MAKE-NEIGHBOR-LIST:
.nofill
⊗⊗ make-neighbor-list[node, g] ← ⊗
⊗⊗ node . map-append[[λx: qif node = qa x qthen <qad x> qelse qNIL], g]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN MAKE-NEIGHBOR-LIST (NODE G)
(CONS NODE
(MAP-APPEND
(FUNCTION (LAMBDA (X)
(COND ((EQ NODE (CAR X)) (LIST (CADR X)))
(T NIL))))
G)))
.end
.next page
Here's a simple solution to the Kirchoff's Current Law problem:
.nofill
⊗⊗ kirch g ← check-kcl-on-nodes[g, all-nodes g]⊗
⊗⊗ check-kcl-on-nodes[g, nodes] ← ⊗
⊗⊗ qif qn nodes qthen qT⊗
⊗⊗ qelse qif zerop sum-of-currents[g, qa nodes] qthen ⊗
⊗⊗ check-kcl-on-nodes[g, qd nodes]⊗
⊗⊗ qelse qNIL⊗
⊗⊗ sum-of-currents[g, node] ← ⊗
⊗⊗ qif qn g qthen 0⊗
⊗⊗ qelse qif qaa g = node qthen sum-of-currents[qd g, node] - qadda g⊗
⊗⊗ qelse qif qada g = node qthen sum-of-currents[qd g, node] + qadda g⊗
⊗⊗ qelse sum-of-currents[qd g, node]⊗
.fill
.begin select 6 indent 8,8 verbatim
(DEFUN KIRCH (G)
(CHECK-KCL-ON-NODES G (ALL-NODES G)))
(DEFUN CHECK-KCL-ON-NODES (G NODES)
(COND ((NULL NODES) T)
((ZEROP (SUM-OF-CURRENTS G (CAR NODES)))
(CHECK-KCL-ON-NODES G (CDR NODES)))
(T NIL)))
(DEFUN SUM-OF-CURRENTS (G NODE)
(COND ((NULL G) 0)
((EQ (CAAR G) NODE) ;current leaving node
(DIFFERENCE (SUM-OF-CURRENTS (CDR G) NODE)
(CADDAR G)))
((EQ (CADAR G) NODE) ;current entering node
(PLUS (SUM-OF-CURRENTS (CDR G) NODE)
(CADDAR G)))
(T (SUM-OF-CURRENTS (CDR G) NODE))))
.end